Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/listdrag/listdrag.frm

Text File | 1995-09-06 | 5KB | 168 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "ListDrag Demo"
   ClientHeight    =   3195
   ClientLeft      =   1875
   ClientTop       =   3660
   ClientWidth     =   5865
   Height          =   3600
   Left            =   1815
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   5865
   Top             =   3315
   Width           =   5985
   Begin ListBox List1
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Courier"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   270
      Left            =   480
      TabIndex        =   0
      Top             =   480
      Width           =   4935
   End
   Begin Label Label2
      Caption         =   "Hold down Ctrl key and use Up and Down arrow keys to move a line in the listbox.  Or press Ctrl and drag a line with the mouse."
      Height          =   620
      Left            =   360
      TabIndex        =   2
      Top             =   2400
      Width           =   5175
   End
   Begin Label Label1
      Enabled         =   0   'False
      Height          =   10
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   10
   End
End
' LISTSWAP.MAK a demonstration Visual Basic program to show
' how single items in a list box can be reordered using
' Ctrl-UpArrow/DownArrow or by pressing Ctrl and dragging
' a list item with the mouse.

' Sue Mosher, 202-736-1136, CIS 75140,543
' Public domain

Dim MoveLine As Integer     ' values: -1 for UP move,
                            ' 1 for DOWN, 0 for none

Dim Item1 As Integer        ' line to be moved
Dim RowSize As Integer
Dim MoveNow As Integer

Const ROWS = 5
Const TRUE = -1
Const FALSE = 0
Const CTRL = 2
Const KEY_UP = &H26
Const KEY_DOWN = &H28

Sub Form_Load ()
    List1.Height = 20 * ROWS * List1.FontSize
    RowSize = List1.Height / ROWS
    For I = 1 To ROWS
        List1.AddItem ("Item " + Str$(I))
    Next I
    List1.ListIndex = 0
    MoveNow = False
End Sub

Sub List1_DragDrop (Source As Control, X As Single, Y As Single)
    MoveNow = False
    Label1.Enabled = False
    List1.SetFocus
End Sub

Sub List1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    Select Case State
        Case 1             ' if leaving list, turn off
            Label1.Drag 2   ' drag & force drop
        Case 2
            If MoveRow(Y) <> 0 Then  ' if within move range
                Item2% = Item1% + MoveRow(Y)
                ListSwap Item1%, Item2%, List1
                Item1% = Item2%
                List1.ListIndex = Item1%
            End If
    End Select
End Sub

Sub List1_KeyDown (KeyCode As Integer, Shift As Integer)
    CtrlDown% = (Shift And CTRL) > 0
    UpPressed% = (KeyCode = KEY_UP)
    DownPressed% = (KeyCode = KEY_DOWN)

    If CtrlDown% And UpPressed% Then
        Item1% = List1.ListIndex        ' set item to be moved
        If Item1% > 0 Then
            MoveLine = -1
        Else
            MoveLine = 0
             Beep
        End If
    End If

    If CtrlDown% And DownPressed% Then
        Item1% = List1.ListIndex
        If Item1% < (List1.ListCount - 1) Then
            MoveLine = 1
        Else
            MoveLine = 0
            Beep
        End If
    End If

    If MoveLine <> 0 Then ListSwap Item1%, (Item1% + MoveLine), List1

End Sub

Sub List1_KeyUp (KeyCode As Integer, Shift As Integer)
    CtrlDown% = (Shift And CTRL) > 0
    If Not CtrlDown% Then MoveLine = 0
End Sub

Sub List1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    CtrlDown% = (Shift And CTRL) > 0
    If CtrlDown% Then
        Item1% = List1.ListIndex
        Label1.Tag = Str$(Item1%)   ' get item to be moved
        MoveNow = True
'       move label control to mouse position and start
'       dragging it
        Label1.Enabled = True
        Label1.Move (List1.Left + X), (List1.Top + Y)
        Label1.Drag 1
    End If
End Sub

Sub ListSwap (Line1 As Integer, Line2 As Integer, ListBox As Control)
    Temp$ = ListBox.List(Line1)
    ListBox.List(Line1) = ListBox.List(Line2)
    ListBox.List(Line2) = Temp$
End Sub

Function MoveRow (Y As Single)
    Offset% = (Y \ RowSize) - Item1%
    If Abs(Offset%) = 1 Then        ' if within 1 row
        MoveRow = Offset%
    Else
        MoveRow = 0
    End If
End Function

Sub SwapInt (Int1%, Int2%)
    TempInt% = Int1%
    Int1% = Int2%
    Int2% = TempInt%
End Sub